home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGSCAL / TURBOK50.LZH / SOURCE.ARC / NESTTTT5.PAS < prev    next >
Pascal/Delphi Source File  |  1989-06-02  |  39KB  |  1,072 lines
  1. {--------------------------------------------------------------------------}
  2. {                         TechnoJock's Turbo Toolkit                       }
  3. {                                                                          }
  4. {                              Version   5.01a                             }
  5. {                                                                          }
  6. {                                                                          }
  7. {              Copyright 1986, 1989 TechnoJock Software, Inc.              }
  8. {                           All Rights Reserved                            }
  9. {                          Restricted by License                           }
  10. {--------------------------------------------------------------------------}
  11.  
  12.                      {--------------------------------}
  13.                      {       Unit:  NestTTT5          }
  14.                      {--------------------------------}
  15.  
  16. {Revision History:    2/13/89    5.00a corrected calculation of Y2 lines
  17.                                  542 and 544. (thanks Mike!)
  18.                                  5.01a  removed refrences to VER50 and
  19.                                         added DEBUG compiler directive
  20. }
  21.  
  22.  
  23. {$S-,R-,V-}       
  24. {$IFNDEF DEBUG}
  25. {$D-}
  26. {$ENDIF}
  27.  
  28. Unit NestTTT5;
  29.  
  30. INTERFACE
  31.  
  32. Uses CRT, FastTTT5, DOS, WinTTT5, KeyTTT5, StrnTTT5;
  33.  
  34. CONST
  35.    Max_Levels = 10;        {maximum number of nested menus - alter if necessary}
  36.    MenuStrLength = 40;     {maximum length of a menu topic - alter if necessary}
  37.    DontClear    = 0;       {signal to return to same position in menu}
  38.    RefreshTopic = 1;       {signal to rewrite highlighted topic}
  39.    RefreshMenu  = 2;       {signal to reload current menu}
  40.    ClearCurrent = 3;       {signal to remove current menu}
  41.    ClearAll     = 4;       {signal to remove all menus}
  42.    Undefined    = 99;      {despatcher has not been assigned}
  43.  
  44. Type
  45.    {$IFNDEF VER40}
  46.    Nest_Key_Proc =   procedure(var Ch:char; Code:Integer);
  47.    Despatcher_Proc = procedure(Var Code: integer; var Finish:byte);
  48.    {$ENDIF}
  49.  
  50.    MenuStr = string[MenuStrLength];
  51.  
  52.    N_Display = record
  53.                      X           : byte;     {top X coord}
  54.                      Y           : byte;     {top Y coord}
  55.                      LeftSide    : boolean;  {does menu start on left or right}
  56.                      AllowEsc    : boolean;  {can user escape from the top level}
  57.                      BoxType     : byte;     {single,double etc}
  58.                      BoxFCol     : byte;     {Border foreground color}
  59.                      BoxBCol     : byte;     {Border background color}
  60.                      CapFCol     : byte;     {Capital letter foreground color}
  61.                      BacCol      : byte;     {menu background color}
  62.                      NorFCol     : byte;     {normal foreground color}
  63.                      LoFCol      : byte;     {inactive topic foreground color}
  64.                      HiFCol      : byte;     {highlighted topic foreground color}
  65.                      HiBCol      : byte;     {highlighted topic background color}
  66.                      LeftChar    : char;     {left-hand topic highlight character}
  67.                      RightChar   : char;     {right-hand topic highlight character}
  68.                      {$IFNDEF VER40}
  69.                      Hook        : Nest_Key_Proc;   { a procedure called after every key is pressed}
  70.                      Despatcher  : Despatcher_proc;     { the main procedure to execute}
  71.                      {$ENDIF}
  72.                end;
  73.  
  74.     TopicPtr    = ^TopicRecord;
  75.  
  76.     MenuPtr     = ^Nest_Menu;
  77.  
  78.     TopicRecord = record
  79.                         Name : MenuStr;
  80.                         Active: boolean;
  81.                         HotKey : char;
  82.                         RetCode : integer;
  83.                         Sub_Menu: MenuPtr;
  84.                         Next_Topic: TopicPtr;
  85.                    end;
  86.  
  87.     Nest_Menu  = record
  88.                         Title: MenuStr;          {title for menu}
  89.                         Topic_Width: byte;       {width of topics in menu}
  90.                         Visible_Lines : word;    {no. topics in box, 0 is DisplayLines - 2}
  91.                         First_Topic : TopicPtr;      {used internally, do not alter}
  92.                         Total_Topics: word;          {used internally, do not alter}
  93.                    end;
  94.  
  95.   VAR
  96.     {$IFDEF VER40}
  97.     Nest_UserHook : pointer;
  98.     Nest_Despatcher: pointer;
  99.     {$ENDIF}
  100.     N_fatal : Boolean;
  101.     N_Error : Integer;
  102.     NTTT    : N_Display;
  103.  
  104.   Procedure Default_Settings;
  105.   {$IFNDEF VER40}
  106.   Procedure Assign_Despatcher(D:Despatcher_Proc);
  107.   {$ENDIF}
  108.  
  109.   Procedure Initialize_Menu(var Menu:Nest_Menu;
  110.                                 Tit: menuStr;
  111.                                 Width: byte;
  112.                                 Display_Lines: word);
  113.  
  114.   Procedure Add_Topic(var Menu:Nest_Menu;
  115.                           Nam : MenuStr;
  116.                           Activ : boolean;
  117.                           HKey : char;
  118.                           Code : integer;
  119.                           Sub: MenuPtr);
  120.  
  121.   Procedure Modify_Topic(var Menu:Nest_Menu;
  122.                              TopicNo : word;
  123.                              Nam : MenuStr;
  124.                              Activ : boolean;
  125.                              HKey  : char;
  126.                              Code : integer;
  127.                              Sub: MenuPtr);
  128.  
  129.   Procedure Modify_Topic_Name(var Menu:Nest_Menu;
  130.                                   TopicNo : word;
  131.                                   Nam : MenuStr);
  132.  
  133.   Procedure Modify_Topic_Active(var Menu:Nest_Menu;
  134.                                   TopicNo : word;
  135.                                   Activ : Boolean);
  136.  
  137.   Procedure Modify_Topic_HotKey(var Menu:Nest_Menu;
  138.                                     TopicNo : word;
  139.                                     HKey : char);
  140.  
  141.   Procedure Modify_Topic_RetCode(var Menu:Nest_Menu;
  142.                                      TopicNo : word;
  143.                                      Code : integer);
  144.  
  145.   Procedure Modify_Topic_SubMenu(var Menu:Nest_Menu;
  146.                                      TopicNo : word;
  147.                                      Sub : MenuPtr);
  148.  
  149.   Procedure Delete_A_Topic(var Menu:Nest_Menu;TopicNo: word);
  150.  
  151.   Procedure Delete_All_Topics(var Menu:Nest_Menu);
  152.  
  153.   Procedure Show_Nest(var Menu:Nest_Menu);
  154.  
  155. IMPLEMENTATION
  156. var
  157.   Despatcher_Assigned : boolean;
  158.  
  159.   Procedure NestTTT_Error(No : byte);
  160.   {Updates N_error and optionally displays error message then halts program}
  161.   var Msg : String;
  162.   begin
  163.       N_error := No;
  164.       If N_fatal = true then
  165.       begin
  166.           Case No of
  167.           1 :  Msg := 'Insufficient memory to add topic';
  168.           2 :  Msg := 'Insufficient memory to save screen';
  169.           3 :  Msg := 'No active picks in menu';
  170.           4 :  Msg := 'Screen was not previously saved cannot restore';
  171.           5 :  Msg := 'Too many levels in menu. Change Max_Levels in NestTTT';
  172.           6 :  Msg := 'Topic does not exist, cannot modify';
  173.           7 :  Msg := 'A user procedure has not been assigned to despatcher';
  174.           else Msg := '?) -- Utterly confused';
  175.           end; {Case}
  176.           Msg := 'Fatal Error (NestTTT -- '+Msg;
  177.           Writeln(Msg);
  178.           Delay(5000);    {display long enough to read if child process}
  179.           Halt;
  180.       end;
  181.   end;
  182.  
  183. {$F+}
  184.   Procedure Empty_Despatcher(Var Code: integer; var Finish:byte);
  185.   {}
  186.   begin
  187.       Finish := Undefined;
  188.   end; {of proc Empty_Despatcher}
  189.  
  190.   Procedure No_Nest_Hook(var Ch : char; Code: Integer);
  191.   {}
  192.   begin
  193.   end; {of proc No_Nest_Hook}
  194. {$F-}
  195.  
  196.    {$IFDEF VER40}
  197.    Procedure CallFromNestUserHook(var Ch:char; code:integer);
  198.           Inline($FF/$1E/Nest_UserHook);
  199.  
  200.    Procedure CallFromNestDespatcher(Var Code: integer; var Finish:byte);
  201.           Inline($FF/$1E/Nest_Despatcher);
  202.    {$ENDIF}
  203.  
  204.   Procedure Default_Settings;
  205.   begin
  206.       with NTTT do
  207.       begin
  208.           X := 0;
  209.           Y := 0;
  210.           Despatcher_Assigned := false;
  211.           LeftSide     := true;
  212.           AllowEsc := true;
  213.           BoxType      := 1;
  214.           If BaseOfScreen = $B800 then
  215.           begin
  216.               BoxFCol      := yellow;
  217.               BoxBCol      := blue;
  218.               CapFCol      := White;
  219.               BacCol       := blue;
  220.               NorFCol      := lightgray;
  221.               LoFCol       := black;
  222.               HiFCol       := white;
  223.               HiBCol       := red;
  224.           end
  225.           else
  226.           begin
  227.               BoxFCol      := white;
  228.               BoxBCol      := black;
  229.               CapFCol      := White;
  230.               BacCol       := black;
  231.               NorFCol      := lightgray;
  232.               LoFCol       := darkgray;
  233.               HiFCol       := white;
  234.               HiBCol       := black;
  235.           end;
  236.           LeftChar     := Chr(16);
  237.           RightChar    := Chr(17);
  238.           {$IFNDEF VER40}
  239.           Hook := No_Nest_Hook;
  240.           Despatcher   := Empty_Despatcher;
  241.           {$ELSE}
  242.            Nest_UserHook := nil;
  243.            Nest_Despatcher:= nil;
  244.           {$ENDIF}
  245.       end;  {with}
  246.   end;  {Default_Settings}
  247.  
  248.   {$IFNDEF VER40}
  249.   Procedure Assign_Despatcher(D:Despatcher_Proc);
  250.   begin
  251.       NTTT.Despatcher := D;
  252.       Despatcher_Assigned := true;
  253.   end;
  254.   {$ENDIF}
  255.  
  256.   Procedure Initialize_Menu(var Menu:Nest_Menu;
  257.                                 Tit: menuStr;
  258.                                 Width: byte;
  259.                                 Display_Lines: word);
  260.   {}
  261.   begin
  262.       With Menu do
  263.       begin
  264.           Title         := Tit;
  265.           Topic_Width   := Width;
  266.           Visible_Lines := Display_Lines;
  267.           First_Topic   := nil;
  268.           Total_Topics  := 0;
  269.       end; {with}
  270.   end; {of proc Initialize_Menu}
  271.  
  272.   Procedure Add_Topic(var Menu:Nest_Menu;
  273.                           Nam : MenuStr;
  274.                           Activ : boolean;
  275.                           HKey  : char;
  276.                           Code : integer;
  277.                           Sub: MenuPtr);
  278.   {Adds a new topic to the menu.}
  279.   var
  280.      TempPtr : TopicPtr;
  281.   begin
  282.       If MaxAvail < SizeOf(TempPtr^) then
  283.       begin
  284.           NestTTT_Error(1);   {not enough memory}
  285.           exit;
  286.       end
  287.       else
  288.          N_Error := 0;
  289.       If Menu.First_Topic = nil then
  290.       begin
  291.          getmem(Menu.First_Topic,SizeOf(TempPtr^));
  292.          TempPtr := Menu.First_Topic;
  293.       end
  294.       else
  295.       begin
  296.          TempPtr := Menu.First_Topic;          {start at bottom}
  297.          while TempPtr^.Next_Topic <> nil do               {loop to unallocated block}
  298.             TempPtr := TempPtr^.Next_Topic;
  299.          GetMem(TempPtr^.Next_Topic,SizeOf(TempPtr^));
  300.          TempPtr := TempPtr^.Next_Topic;
  301.       end;
  302.       with TempPtr^ do
  303.       begin
  304.           Name := Nam;
  305.           If (Name = '-') or (Name = '=') then
  306.              Active := false
  307.           else
  308.              Active := Activ;
  309.           HotKey := Hkey;
  310.           RetCode := Code;
  311.           Sub_Menu := Sub;
  312.           Next_Topic := nil;
  313.       end;
  314.       Inc(Menu.Total_Topics);
  315.   end; {of proc Add_Topic}
  316.  
  317.   Function Pointer_to_Topic(Men:Nest_Menu;TopicNo:word): TopicPtr;
  318.   {returns a pointer to the TopicNo'th entry in menu, or nil
  319.    if greater than Total_Topics}    
  320.   var    
  321.      W       : word;    
  322.      TempPtr : TopicPtr;    
  323.   begin    
  324.       with Men do
  325.       begin    
  326.           If TopicNo > Total_Topics then
  327.              TempPtr := nil
  328.           else    
  329.           begin
  330.               TempPtr := First_Topic;    
  331.               For W := 2 to TopicNo do    
  332.                       TempPtr := TempPtr^.Next_Topic    
  333.           end;    
  334.       end;    
  335.       Pointer_to_Topic := TempPtr;    
  336.   end; {of func Pointer_to_Topic}
  337.  
  338.   Procedure Modify_Topic(var Menu:Nest_Menu;
  339.                              TopicNo : word;
  340.                              Nam : MenuStr;
  341.                              Activ : boolean;
  342.                              HKey  : char;
  343.                              Code : integer;
  344.                              Sub: MenuPtr);
  345.   {Changes all the settings for a topic}
  346.   var TempPtr : TopicPtr;
  347.   begin
  348.       TempPtr := Pointer_To_Topic(Menu,TopicNo);
  349.       If TempPtr = nil then 
  350.          NestTTT_Error(6);
  351.       With TempPtr^ do
  352.       begin
  353.           Name := Nam;
  354.           If (Name = '-') or (Name = '=') then
  355.              Active := false
  356.           else
  357.              Active := Activ;
  358.           HotKey := Hkey;
  359.           RetCode := Code;
  360.           Sub_Menu := Sub;
  361.       end; {with}
  362.   end; {of proc Modify_Topic}
  363.  
  364.   Procedure Modify_Topic_Name(var Menu:Nest_Menu;
  365.                                   TopicNo : word;
  366.                                   Nam : MenuStr);
  367.   {Change title or name of a topic}
  368.   var TempPtr : TopicPtr;
  369.   begin
  370.       TempPtr := Pointer_To_Topic(Menu,TopicNo);
  371.       If TempPtr = nil then 
  372.          NestTTT_Error(6);
  373.       TempPtr^.Name := Nam;
  374.       If (Nam = '-') or (Nam = '=') then
  375.              TempPtr^.Active := false;
  376.   end; {of proc Modify_Topic_Name}
  377.  
  378.   Procedure Modify_Topic_Active(var Menu:Nest_Menu;
  379.                                   TopicNo : word;
  380.                                   Activ : Boolean);
  381.   {Changes active status of a topic}
  382.   var TempPtr : TopicPtr;
  383.   begin
  384.       TempPtr := Pointer_To_Topic(Menu,TopicNo);
  385.       If TempPtr = nil then 
  386.          NestTTT_Error(6);
  387.       TempPtr^.Active := Activ;
  388.   end; {of proc Modify_Topic_Active}
  389.  
  390.   Procedure Modify_Topic_HotKey(var Menu:Nest_Menu;
  391.                                     TopicNo : word;
  392.                                     HKey : char);
  393.   {Changes Hotkey character of a topic}
  394.   var TempPtr : TopicPtr;
  395.   begin
  396.       TempPtr := Pointer_To_Topic(Menu,TopicNo);
  397.       If TempPtr = nil then
  398.          NestTTT_Error(6);
  399.       TempPtr^.HotKey := HKey;
  400.   end; {of proc Modify_Topic_HotKey}
  401.  
  402.   Procedure Modify_Topic_RetCode(var Menu:Nest_Menu;
  403.                                      TopicNo : word;
  404.                                      Code : integer);
  405.   {Changes Return code for a topic}
  406.   var TempPtr : TopicPtr;
  407.   begin
  408.       TempPtr := Pointer_To_Topic(Menu,TopicNo);
  409.       If TempPtr = nil then 
  410.          NestTTT_Error(6);
  411.       TempPtr^.Retcode := Code;
  412.   end; {of proc Modify_Topic_HotKey}
  413.  
  414.   Procedure Modify_Topic_SubMenu(var Menu:Nest_Menu;
  415.                                      TopicNo : word;
  416.                                      Sub : MenuPtr);
  417.   {Changes Return code for a topic}
  418.   var TempPtr : TopicPtr;
  419.   begin
  420.       TempPtr := Pointer_To_Topic(Menu,TopicNo);
  421.       If TempPtr = nil then
  422.          NestTTT_Error(6);
  423.       TempPtr^.Sub_Menu := Sub;
  424.   end; {of proc Modify_Topic_HotKey}
  425.  
  426.   Procedure Delete_A_Topic(var Menu:Nest_Menu;TopicNo: word);
  427.   {}
  428.   var TempPtrA,TempPtrB : TopicPtr;
  429.   begin
  430.       If TopicNo = 1 then
  431.       begin
  432.           If Menu.First_Topic = nil then
  433.              NestTTT_Error(6);
  434.           TempPtrA := Menu.First_Topic^.Next_Topic;
  435.           FreeMem(Menu.First_Topic,SizeOf(TempPtrA^));
  436.           Menu.First_Topic := TempPtrA;
  437.       end
  438.       else
  439.       begin
  440.           TempPtrA := Pointer_To_Topic(Menu,pred(TopicNo));
  441.           If TempPtrA = nil then
  442.              NestTTT_Error(6);
  443.           TempPtrB := Pointer_To_Topic(Menu,TopicNo);
  444.           If TempPtrB = nil then
  445.              NestTTT_Error(6);
  446.           TempPtrA^.Next_Topic := TempPtrB^.Next_Topic;
  447.           FreeMem(TempPtrB,SizeOf(TempPtrB^));
  448.       end;
  449.       Dec(Menu.Total_Topics);
  450.   end; {of proc Delete_A_Topic}
  451.  
  452.   Procedure Delete_All_Topics(var Menu:Nest_Menu);
  453.   {}
  454.   var TempPtrA,TempPtrB : TopicPtr;
  455.   begin
  456.       TempPtrA := Menu.First_Topic;
  457.       While (TempPtrA <> nil) do
  458.       begin
  459.           TempPtrB := TempPtrA^.Next_Topic;
  460.           If TempPtrA <> nil then
  461.           begin
  462.               FreeMem(TempPtrA,SizeOf(TempPtrA^));
  463.               TempPtrA := TempPtrB;
  464.           end;
  465.       end;
  466.       Menu.First_Topic := nil;
  467.   end; {of proc Delete_All_Topics}
  468.  
  469.   Procedure Show_Nest(var Menu:Nest_Menu);
  470.   Type
  471.      LevelInfo = record
  472.                       Pick : word;
  473.                       TheMenu : MenuPtr;     {link to menu}
  474.                       X1   : integer;           {coords of saved screens}
  475.                       Y1   : integer;
  476.                       X2   : integer;
  477.                       Y2   : integer;
  478.                       TopPick : byte;
  479.                       HiPick  : byte;
  480.                       Saved_Screen: Pointer; {location of saved screen}
  481.                  end;
  482.   Var
  483.      I : word;
  484.      TempPtr : TopicPtr;
  485.      FinCode : byte;
  486.      Nest : array[1..Max_Levels] of LevelInfo;
  487.      Current_Level : byte;
  488.      LiveMenu : Nest_menu;
  489.      ChL : char;
  490.      Found,
  491.      Finished : boolean;
  492.  
  493.       Function Topic_Pointer(TopicNo:word): TopicPtr;
  494.       begin
  495.           Topic_Pointer := Pointer_to_Topic(LiveMenu,TopicNo);
  496.       end; {of func Topic_Pointer}
  497.  
  498.  
  499.       Procedure Compute_Coords(var LiveMenu:Nest_Menu);
  500.       {determines X1,Y1,X2,Y2 for new menu}
  501.       begin
  502.           With Nest[Current_level] do
  503.           begin
  504.               If LiveMenu.Visible_Lines = 0 then
  505.                  LiveMenu.Visible_Lines := DisplayLines-2;
  506.               If LiveMenu.Total_Topics < LiveMenu.Visible_Lines then
  507.                  LiveMenu.Visible_Lines := LiveMenu.Total_Topics;
  508.               If Current_Level = 1 then
  509.               begin
  510.                   If NTTT.X = 0 then
  511.                   begin
  512.                       If NTTT.LeftSide then
  513.                       begin
  514.                           X1 := 1;
  515.                           X2 := LiveMenu.Topic_Width + 4;
  516.                       end
  517.                       else    {RightSide}
  518.                       begin
  519.                           X2 := 80;
  520.                           X1 := 80 - LiveMenu.Topic_Width - 3;
  521.                       end;
  522.                   end
  523.                   else {X not Zero}
  524.                   begin
  525.                       If NTTT.LeftSide then
  526.                       begin
  527.                           X1 := NTTT.X;
  528.                           X2 := pred(X1)+LiveMenu.Topic_Width + 4;
  529.                           If X2 > 80 then
  530.                           begin
  531.                               X2 := 80;
  532.                               X1 := X2 - 3 - LiveMenu.Topic_Width;
  533.                           end;
  534.                       end
  535.                       else    {RightSide}
  536.                       begin
  537.                           X2 := NTTT.X;
  538.                           X1 := X2 - LiveMenu.Topic_Width - 3;
  539.                           If X1 < 1 then
  540.                           begin
  541.                               X1 := 1;
  542.                               X2 := X1 +LiveMenu.Topic_Width +3;
  543.                           end;
  544.                       end;
  545.                   end;
  546.                   If NTTT.Y = 0 then
  547.                      Y1 := 1
  548.                   else
  549.                      Y1 := NTTT.Y;
  550.                   If LiveMenu.Total_Topics >= LiveMenu.Visible_Lines then
  551. {mod 5.00a}          Y2 := Y1 + succ(LiveMenu.Visible_Lines)
  552.                   else
  553.                      Y2 := Y1 + succ(LiveMenu.Total_Topics);
  554.                   If Y2 > DisplayLines then
  555.                   begin
  556.                      Y2 := DisplayLines;
  557.                      LiveMenu.Visible_Lines := Y2 - succ(Y1);
  558.                   end;
  559.               end
  560.               else   {not the first level menu}
  561.               begin
  562.                   If NTTT.LeftSide then
  563.                   begin
  564.                       X1 := pred(Nest[pred(Current_Level)].X2);
  565.                       X2 := X1 + 3 + LiveMenu.Topic_Width;
  566.                       If X2 > 80 then
  567.                       begin
  568.                           X2 := 80;
  569.                           X1 := X2 - 4 - LiveMenu.Topic_Width;
  570.                       end;
  571.                   end
  572.                   else   {rightside}
  573.                   begin
  574.                       X2 := succ(Nest[pred(Current_Level)].X1);
  575.                       X1 := X2 - LiveMenu.Topic_Width - 3;
  576.                       If X1 < 1 then
  577.                       begin
  578.                           X1 := 1;
  579.                           X2 := X1 +LiveMenu.Topic_Width +3;
  580.                       end;
  581.                   end;
  582.                   Y1 := succ(Nest[Pred(Current_Level)].Y1) +
  583.                         Nest[Pred(Current_Level)].HiPick -
  584.                         Nest[Pred(Current_Level)].TopPick;
  585.                   If LiveMenu.Total_Topics >= LiveMenu.Visible_Lines then
  586.                      Y2 := succ(Y1) + LiveMenu.Visible_Lines
  587.                   else
  588.                      Y2 := succ(Y1) + LiveMenu.Total_Topics;
  589.                   If Y2 > DisplayLines then
  590.                   begin
  591.                      Y2 := DisplayLines;
  592.                      If Y2 - succ(LiveMenu.Visible_Lines) >= 1 then
  593.                         Y1 := Y2 - succ(LiveMenu.Visible_Lines)
  594.                      else
  595.                      begin
  596.                          Y1 := 1;
  597.                          LiveMenu.Visible_Lines := DisplayLines - 2;
  598.                      end;
  599.                   end;
  600.               end;
  601.           end; {With}
  602.       end; {of proc Compute_Coords}
  603.  
  604.       Procedure Save_Screen;
  605.       {saved part of screen overlayed by menu}
  606.       begin
  607.           with Nest[Current_Level] do
  608.           begin
  609.               If MaxAvail < succ(Y2-Y1)*succ(X2-X1)*2 then
  610.                   NestTTT_Error(2)
  611.               else
  612.               begin
  613.                   GetMem(Saved_Screen,succ(Y2-Y1)*succ(X2-X1)*2);
  614.                   PartSave(X1,Y1,X2,Y2,Saved_Screen^);
  615.               end;
  616.           end;
  617.       end; {of proc Save_Screen}
  618.  
  619.       Procedure Restore_Screen;
  620.       {saved part of screen overlayed by menu}
  621.       begin
  622.           with Nest[Current_Level] do
  623.           begin
  624.               If Saved_Screen = nil then
  625.                   NestTTT_Error(4)
  626.               else
  627.               begin
  628.                   PartRestore(X1,Y1,X2,Y2,Saved_Screen^);
  629.                   FreeMem(Saved_Screen,succ(Y2-Y1)*succ(X2-X1)*2);
  630.               end;
  631.           end;
  632.       end; {of proc Restore_Screen}
  633.  
  634.       Procedure Compute_First_Active_Pick;
  635.       {}
  636.       var I : word;
  637.       begin
  638.           With Nest[Current_level] do
  639.           begin
  640.               TopPick := 1;
  641.               HiPick := 1;
  642.               While (Topic_Pointer(HiPick)^.Active = false)
  643.               and   (HiPick < LiveMenu.Total_Topics) do
  644.                     Inc(HiPick);
  645.               If (Topic_Pointer(HiPick)^.Active = false) then {no active picks in menu}
  646.               begin
  647.                   NestTTT_Error(3);
  648.                   exit;
  649.               end;
  650.               If HiPick > LiveMenu.Visible_Lines then
  651.                  TopPick := HiPick - pred(LiveMenu.Visible_Lines);
  652.           end; {with}
  653.       end; {of proc Compute_First_Active_Pick}
  654.  
  655.       Procedure Compute_Topic_Width(var Livemenu:Nest_Menu);
  656.       {}
  657.       var
  658.         I : word;
  659.         W,Biggest : Byte;
  660.       begin
  661.           Biggest := 0;
  662.           For I := 1 To LiveMenu.Total_Topics do
  663.           begin
  664.               W := length(Topic_Pointer(I)^.Name);
  665.               If Biggest < W then
  666.                  Biggest := W;
  667.           end;
  668.           If Biggest < length(LiveMenu.Title) then
  669.              Biggest := length(LiveMenu.Title);
  670.           LiveMenu.Topic_Width := Biggest;
  671.       end; {of proc Compute_Topic_Width}
  672.  
  673.       Procedure Write_Topic(TopicNo:word;Hilight:boolean);
  674.       {}
  675.       var
  676.         A,Y : byte;
  677.         T : TopicPtr;
  678.       begin
  679.          T := Topic_Pointer(TopicNo);
  680.          If T = Nil then
  681.             exit;
  682.          If HiLight then
  683.             A := attr(NTTT.HiFCol,NTTT.HiBCol)
  684.          else
  685.          begin
  686.              If T^.Active then
  687.                 A := attr(NTTT.NorFcol,NTTT.BacCol)
  688.              else
  689.                 A := attr(NTTT.LoFcol,NTTT.BacCol);
  690.          end;
  691.          with Nest[Current_level] do
  692.          begin
  693.              Y := succ(Y1) + TopicNo - TopPick;
  694.              If HiLight then
  695.                 Fastwrite(succ(X1),Y,A,
  696.                           NTTT.LeftChar+
  697.                           PadLeft(T^.Name,LiveMenu.Topic_Width,' ')+
  698.                           NTTT.Rightchar)
  699.              else
  700.                 Case T^.Name[1] of
  701.                 '-': HorizLine(Succ(X1),Pred(X2),Y,NTTT.BoxFCol,NTTT.BacCol,1);
  702.                 '=': HorizLine(Succ(X1),Pred(X2),Y,NTTT.BoxFCol,NTTT.BacCol,1);
  703.                 else
  704.                     begin
  705.                         Fastwrite(succ(X1),Y,A,
  706.                                   ' '+
  707.                                   PadLeft(T^.Name,LiveMenu.Topic_Width,' ')+
  708.                                   ' ');
  709.                         If (T^.Active) and (First_Capital_Pos(T^.Name) > 0) then
  710.                            Fastwrite(succ(X1)+First_Capital_Pos(T^.Name),
  711.                                      Y,
  712.                                      attr(NTTT.CapFCol,NTTT.BacCol),
  713.                                      First_Capital(T^.Name));
  714.                     end;
  715.                 end; {Case}
  716.          end;
  717.       end; {of proc Write_Topic}
  718.  
  719.       Procedure Display_All_Topics;
  720.       {}
  721.       var I : Integer;
  722.       begin
  723.           with Nest[Current_Level] do
  724.           begin
  725.               For I := TopPick to TopPick+pred(LiveMenu.Visible_Lines) do
  726.                   Write_Topic(I,false);
  727.               Write_Topic(HiPick,true);
  728.           end;
  729.       end; {of proc Display_All_Topics}
  730.  
  731.       Procedure Display_LiveMenu;
  732.       {}
  733.       begin
  734.           with Nest[Current_Level] do
  735.           begin
  736.               FBox(X1,Y1,X2,Y2,NTTT.BoxFCol,NTTT.BoxBCol,NTTT.BoxType);
  737.               WriteBetween(X1,X2,Y1,NTTT.BoxFCol,NTTT.BoxBCol,Livemenu.Title);
  738.           end;
  739.           Display_All_Topics;
  740.       end; {of proc Display_LiveMenu}
  741.  
  742.       Function Next_Pick_Down(Wrap:boolean): word;
  743.       {}
  744.       var P : word;
  745.       begin
  746.           with Nest[Current_Level] do
  747.           begin
  748.               P := HiPick;
  749.               If P < LiveMenu.Total_Topics then
  750.               begin
  751.                   inc(P);
  752.                   while (P < LiveMenu.Total_Topics)
  753.                   and   (Topic_Pointer(P)^.Active = false) do
  754.                         Inc(P);
  755.                   If Topic_Pointer(P)^.Active = false then
  756.                   begin
  757.                       If Wrap and (LiveMenu.Total_Topics <= LiveMenu.Visible_Lines) then
  758.                       begin
  759.                          P := TopPick;  {scroll to top}
  760.                          while (P < LiveMenu.Total_Topics)
  761.                          and   (Topic_Pointer(P)^.Active = false) do
  762.                                Inc(P);
  763.                       end
  764.                       else
  765.                          P := Hipick;
  766.                   end;
  767.               end
  768.               else     {P is at bottom of menu}
  769.               begin
  770.                   If Wrap and (LiveMenu.Total_Topics <= LiveMenu.Visible_Lines) then
  771.                      P := TopPick;  {scroll to top}
  772.                   while (P < LiveMenu.Total_Topics)
  773.                   and   (Topic_Pointer(P)^.Active = false) do
  774.                         Inc(P);
  775.               end;
  776.               Next_Pick_Down := P;
  777.           end; {with}
  778.       end; {of func Next_Pick_Down}
  779.  
  780.       Function Next_Pick_Up(Wrap:boolean): word;
  781.       {}
  782.       var P : word;
  783.       begin
  784.           with Nest[Current_Level] do
  785.           begin
  786.               P := HiPick;
  787.               If P > 1 then
  788.               begin
  789.                   dec(P);
  790.                   while (P > 1)
  791.                   and   (Topic_Pointer(P)^.Active = false) do
  792.                         Dec(P);
  793.                   If Topic_Pointer(P)^.Active = false then
  794.                   begin
  795.                       If Wrap and (LiveMenu.Total_Topics <= LiveMenu.Visible_Lines) then
  796.                       begin
  797.                          P := LiveMenu.Total_Topics;  {scroll to top}
  798.                          while (P > 1)
  799.                          and   (Topic_Pointer(P)^.Active = false) do
  800.                                Dec(P);
  801.                       end
  802.                       else
  803.                          P := Hipick;
  804.                   end;
  805.               end
  806.               else     {P is at top of menu}
  807.               begin
  808.                   If Wrap and (LiveMenu.Total_Topics <= LiveMenu.Visible_Lines) then
  809.                   begin
  810.                      P := LiveMenu.Total_Topics;  {scroll to top}
  811.                      while (P > 1)
  812.                      and   (Topic_Pointer(P)^.Active = false) do
  813.                            Dec(P);
  814.                   end;
  815.               end;
  816.               Next_Pick_Up := P;
  817.           end; {with}
  818.       end; {of func Next_Pick_Up}
  819.  
  820.       Procedure Load_Menu(var NewMenu:Nest_Menu);
  821.       {}
  822.       begin
  823.           If Current_Level < Max_Levels then
  824.              Inc(Current_Level)
  825.           else
  826.              NestTTT_Error(5);
  827.           Nest[Current_Level].TheMenu := @NewMenu;
  828.           LiveMenu := NewMenu;
  829.           If LiveMenu.Topic_Width <= 0 then
  830.           begin
  831.              Compute_Topic_Width(LiveMenu);
  832.              NewMenu.Topic_Width := LiveMenu.Topic_Width;
  833.           end;
  834.           Compute_Coords(LiveMenu);
  835.           Compute_Coords(NewMenu);
  836.           Compute_First_Active_Pick;
  837.           Save_Screen;
  838.           Display_LiveMenu;
  839.       end; {of proc Load_Menu;}
  840.  
  841.       Procedure Execute_Command;
  842.       {}
  843.       var
  844.          TempPtr : TopicPtr;
  845.          Code : integer;
  846.       begin
  847.           TempPtr := Topic_Pointer(Nest[Current_Level].HiPick);
  848.           If TempPtr^.Sub_Menu <> nil then
  849.              Load_Menu(TempPtr^.Sub_Menu^)
  850.           else
  851.           begin
  852.               Code := TempPtr^.Retcode;
  853.               {$IFNDEF VER40}
  854.               NTTT.Despatcher(Code,Fincode);
  855.               {$ELSE}
  856.               If Nest_Despatcher <> Nil then
  857.                  CallFromNestDespatcher(Code,Fincode)
  858.               else
  859.                  Fincode := Undefined;
  860.               {$ENDIF}
  861.               Case Fincode of
  862.               Undefined    :NestTTT_Error(7);
  863.               DontClear    :;
  864.               RefreshTopic : Write_Topic(Nest[Current_Level].HiPick,True);
  865.               RefreshMenu  : Display_All_Topics;
  866.               ClearCurrent : begin
  867.                                  Restore_Screen;
  868.                                  If Current_Level > 1 then
  869.                                  begin
  870.                                     Dec(Current_Level);
  871.                                     LiveMenu := Nest[Current_Level].TheMenu^;
  872.                                  end
  873.                                  else
  874.                                     Finished := true;
  875.                              end;
  876.               ClearAll     : begin
  877.                                  While Current_Level > 0 do
  878.                                  begin
  879.                                      Restore_Screen;
  880.                                      Dec(Current_Level);
  881.                                      LiveMenu := Nest[Current_Level].TheMenu^;
  882.                                  end;
  883.                                  Finished := true;
  884.                              end;
  885.               end; {Case}
  886.           end;
  887.       end; {of proc Execute_Command}
  888.  
  889.      Procedure Display_More;
  890.      {}
  891.      var A : byte;
  892.      begin
  893.          If LiveMenu.Visible_Lines < Livemenu.Total_Topics then
  894.             with  Nest[Current_Level] do
  895.             begin
  896.                 A := attr(NTTT.CapFCol,NTTT.BoxBCol);
  897.                 If TopPick > 1 then
  898.                    Fastwrite(X2,Succ(Y1),A,chr(24))
  899.                 else
  900.                    VertLine(X2,Succ(Y1),Succ(Y1),NTTT.BoxFcol,NTTT.BoxBCol,Nttt.Boxtype);
  901.                 If TopPick + Pred(LiveMenu.Visible_Lines) < LiveMenu.Total_Topics then
  902.                    Fastwrite(X2,Pred(Y2),A,chr(25))
  903.                 else
  904.                    VertLine(X2,Pred(Y2),Pred(Y2),NTTT.BoxFcol,NTTT.BoxBCol,Nttt.Boxtype);
  905.             end;
  906.      end; {of proc Display_More}
  907.  
  908.   begin
  909.       Current_level := 0;
  910.       {$IFNDEF VER40}
  911.       If not Despatcher_Assigned then
  912.          NestTTT_Error(7);
  913.       {$ELSE}
  914.       If Nest_Despatcher = nil then
  915.          NestTTT_Error(7);
  916.       {$ENDIF}
  917.       Load_Menu(Menu);
  918.       Finished := False;
  919.       Repeat
  920.            Display_More;
  921.            ChL := GetKey;
  922.            {$IFNDEF VER40}
  923.            NTTT.Hook(ChL,Topic_Pointer(Nest[Current_Level].HiPick)^.RetCode);
  924.            {$ELSE}
  925.            If Nest_UserHook <> Nil then
  926.               CallFromNestUserHook(ChL,Topic_Pointer(Nest[Current_Level].HiPick)^.RetCode);
  927.            {$ENDIF}
  928.            If ChL <> #0 then
  929.            Case upcase(ChL) of
  930.            #132,                               {right button}
  931.            #027    : If Current_Level = 1 then
  932.                      begin
  933.                          If NTTT.AllowEsc then
  934.                          begin
  935.                              Restore_Screen;
  936.                              Finished := true;
  937.                          end;
  938.                      end
  939.                      else
  940.                      begin
  941.                          Restore_Screen;
  942.                          Dec(Current_Level);
  943.                          LiveMenu := Nest[Current_Level].TheMenu^;
  944.                      end;
  945.            #133,                                       {Mouse left button}
  946.            #13     : begin                             {Enter}
  947.                          Execute_Command;
  948.                      end;
  949.            ' ',
  950.            #129,                                       {Mouse down}
  951.            #208    : with Nest[Current_Level] do       {Down arrow}
  952.                      begin
  953.                          Write_Topic(HiPick,False);
  954.                          HiPick := Next_Pick_Down(ChL = #208);
  955.                          If HiPick >= TopPick + LiveMenu.Visible_Lines then
  956.                          begin
  957.                              TopPick := HiPick - pred(LiveMenu.Visible_Lines);
  958.                              Display_All_Topics;
  959.                          end;
  960.                          Write_Topic(HiPick,True);
  961.                      end;
  962.            #128,                                       {Mouse up}
  963.            #200    : with Nest[Current_Level] do       {Up arrow}
  964.                      begin
  965.                          Write_Topic(HiPick,False);
  966.                          HiPick := Next_Pick_Up(ChL = #200);
  967.                          If HiPick < TopPick  then
  968.                          begin
  969.                              TopPick := HiPick;
  970.                              Display_All_Topics;
  971.                          end;
  972.                          Write_Topic(HiPick,True);
  973.                      end;
  974.             #199   : If Nest[Current_Level].HiPick <> 1 then      {Home}
  975.                      begin
  976.                          Compute_First_Active_Pick;
  977.                          Display_All_Topics;
  978.                      end;
  979.             #207   : With Nest[Current_Level] do
  980.                      begin
  981.                          Write_Topic(HiPick,False);
  982.                          HiPick := LiveMenu.Total_Topics;
  983.                          While (HiPick > 0)
  984.                          and (Topic_Pointer(HiPick)^.Active =false) do
  985.                               Dec(HiPick);
  986.                          If HiPick >= TopPick + LiveMenu.Visible_Lines then
  987.                          begin
  988.                              TopPick := HiPick - pred(LiveMenu.Visible_Lines);
  989.                              Display_All_Topics;
  990.                          end;
  991.                          Write_Topic(HiPick,True);
  992.                      end;
  993.            'A'..'Z': with Nest[Current_Level] do
  994.                      begin
  995.                          Found := false;
  996.                          I := HiPick;
  997.                          Repeat      
  998.                               TempPtr := Topic_Pointer(I);
  999.                               If  (First_Capital(TempPtr^.Name) = upcase(ChL))
  1000.                               and (TempPtr^.Active) then      
  1001.                               begin      
  1002.                                   Found := true;
  1003.                                   Write_Topic(HiPick,false);      
  1004.                                   HiPick := I;
  1005.                                   If HiPick >= TopPick + LiveMenu.Visible_Lines then
  1006.                                   begin
  1007.                                       TopPick := HiPick - pred(LiveMenu.Visible_Lines);
  1008.                                       Display_All_Topics;
  1009.                                   end
  1010.                                   else
  1011.                                      If HiPick < TopPick  then
  1012.                                      begin
  1013.                                          TopPick := HiPick;
  1014.                                          Display_All_Topics;
  1015.                                      end;
  1016.                                      Write_Topic(HiPick,true);
  1017.                               end      
  1018.                               else      
  1019.                                   If I = LiveMenu.Total_Topics then
  1020.                                      I := 1
  1021.                                   else
  1022.                                      Inc(I);
  1023.                          Until Found or (I = HiPick);
  1024.                          If Found then
  1025.                             Execute_Command;
  1026.                      end;
  1027.            else   {see if the user pressed a special key}
  1028.                with Nest[Current_Level] do
  1029.                begin
  1030.                Found := false;
  1031.                I := HiPick;
  1032.                Repeat
  1033.                     TempPtr := Topic_Pointer(I);
  1034.                     If  ((TempPtr^.Hotkey) = ChL)
  1035.                     and (TempPtr^.Active) then
  1036.                     begin
  1037.                         Found := true;
  1038.                         Write_Topic(HiPick,false);
  1039.                         HiPick := I;
  1040.                         If HiPick >= TopPick + LiveMenu.Visible_Lines then
  1041.                         begin
  1042.                             TopPick := HiPick - pred(LiveMenu.Visible_Lines);
  1043.                             Display_All_Topics;
  1044.                         end
  1045.                         else
  1046.                            If HiPick < TopPick  then
  1047.                            begin
  1048.                                TopPick := HiPick;
  1049.                                Display_All_Topics;
  1050.                            end;
  1051.                            Write_Topic(HiPick,true);
  1052.                     end
  1053.                     else
  1054.                         If I = LiveMenu.Total_Topics then
  1055.                            I := 1
  1056.                         else
  1057.                            Inc(I);
  1058.                Until Found or (I = HiPick);
  1059.                If Found then
  1060.                   Execute_Command;
  1061.                end;
  1062.       end; {case}
  1063.       Until Finished;
  1064.   end; {of proc Show_Nest}
  1065.  
  1066.  
  1067. begin
  1068.     Default_Settings;
  1069.     N_Fatal := true;
  1070. end.
  1071.  
  1072.